home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / BBS_UTL / TOOL_USE / PULL.PAS < prev    next >
Pascal/Delphi Source File  |  1989-03-01  |  14KB  |  371 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * Example program for pulldown menu system
  15.  *
  16.  * Samuel H. Smith, 13-nov-87
  17.  *
  18.  *)
  19.  
  20. {$t+}
  21.  
  22. uses CRT;
  23.  
  24. {$i \tinc\getkey.inc}
  25. {$i \tinc\pop3.inc}
  26. {$i \tinc\border.inc}
  27. {$i \tinc\pull.inc}
  28.  
  29.  
  30. {define pulldown menu codes}
  31. const
  32.    UNDEFINED_MENU = 1;
  33.    CALIB_MENU     = 2;
  34.    DISPLAY_MENU   = 3;
  35.    GRAPH_MENU     = 4;
  36.    REPORT_MENU    = 5;
  37.    FILES_MENU     = 6;
  38.    SETUP_MENU     = 7;
  39.    QUIT_MENU      = 8;
  40.  
  41.  
  42. {define line item actions}
  43. const
  44.    UNDEF_ACTION   = 10000;
  45.    LEAVE_MENU     = 10001;
  46.    QUIT_TOP       = 10002;
  47.  
  48.  
  49.  
  50. {define pulldown menu contents}
  51. const
  52.    pull_count = 8;
  53.    pull_table: array[0..pull_count] of pulldown_rec = (
  54.  
  55.       ( border:    taildouble_border;
  56.         border_fg: white;  border_bg: black;   {color definition}
  57.         text_fg:   white;  text_bg:   black;
  58.         select_fg: black;  select_bg: white;
  59.         ainit:     0;      aexit:     0;       {init and exit actions}
  60.  
  61.         line: ( (title: 'Calibrate';    action: CALIB_MENU),
  62.                 (title: 'Display';      action: DISPLAY_MENU),
  63.                 (title: 'Graph';        action: GRAPH_MENU),
  64.                 (title: 'Report';       action: REPORT_MENU),
  65.                 (title: 'File';         action: FILES_MENU),
  66.                 (title: 'Setup';        action: SETUP_MENU),
  67.                 (title: 'Test';         action: UNDEFINED_MENU),
  68.                 (title: 'Quit';         action: QUIT_MENU),
  69.                 (title: '';             action: unused_entry),
  70.                 (title: '';             action: unused_entry) )),
  71.  
  72.  
  73.       ( border:    single_border;
  74.         border_fg: white;  border_bg: black;
  75.         text_fg:   white;  text_bg:   black;
  76.         select_fg: black;  select_bg: white;
  77.         ainit:     0;      aexit:     0;
  78.  
  79.         line: ( (title: 'Function not implemented';     action: divider_entry),
  80.                 (title: '         Cancel         ';     action: LEAVE_MENU),
  81.                 (title: '';             action: unused_entry),
  82.                 (title: '';             action: unused_entry),
  83.                 (title: '';             action: unused_entry),
  84.                 (title: '';             action: unused_entry),
  85.                 (title: '';             action: unused_entry),
  86.                 (title: '';             action: unused_entry),
  87.                 (title: '';             action: unused_entry),
  88.                 (title: '';             action: unused_entry) )), 
  89.  
  90.  
  91.       ( border:    taildouble_border;
  92.         border_fg: white;  border_bg: black;
  93.         text_fg:   white;  text_bg:   black;
  94.         select_fg: black;  select_bg: white;
  95.         ainit:     0;      aexit:     0;
  96.  
  97.         line: ( (title: 'New calibration';      action: UNDEF_ACTION),
  98.                 (title: 'Single run';           action: UNDEF_ACTION),
  99.                 (title: 'Automatic run';        action: UNDEF_ACTION),
  100.                 (title: 'Options...';           action: UNDEF_ACTION),
  101.                 (title: '';                     action: unused_entry),
  102.                 (title: '';                     action: unused_entry),
  103.                 (title: '';                     action: unused_entry),
  104.                 (title: '';                     action: unused_entry),
  105.                 (title: '';                     action: unused_entry),
  106.                 (title: '';                     action: unused_entry) )),
  107.  
  108.  
  109.       ( border:    taildouble_border;
  110.         border_fg: white;  border_bg: black;
  111.         text_fg:   white;  text_bg:   black;
  112.         select_fg: black;  select_bg: white;
  113.         ainit:     0;      aexit:     0;
  114.  
  115.         line: ( (title: 'Next';                 action: UNDEF_ACTION),
  116.                 (title: 'Previous';             action: UNDEF_ACTION),
  117.                 (title: 'Delete';               action: UNDEF_ACTION),
  118.                 (title: 'Insert';               action: UNDEF_ACTION),
  119.                 (title: 'Edit';                 action: UNDEF_ACTION),
  120.                 (title: 'Formula';              action: UNDEF_ACTION),
  121.                 (title: 'Recalculate';          action: UNDEF_ACTION),
  122.                 (title: '';                     action: unused_entry),
  123.                 (title: '';                     action: unused_entry),
  124.                 (title: '';                     action: unused_entry) )),
  125.  
  126.  
  127.       ( border:    taildouble_border;
  128.         border_fg: white;  border_bg: black;
  129.         text_fg:   white;  text_bg:   black;
  130.         select_fg: black;  select_bg: white;
  131.         ainit:     0;      aexit:     0;
  132.  
  133.         line: ( (title: 'K vs Flow';            action: UNDEF_ACTION),
  134.                 (title: 'K vs Frequency';       action: UNDEF_ACTION),
  135.                 (title: 'Freq vs Flow';         action: UNDEF_ACTION),
  136.                 (title: 'K vs Reynolds';        action: UNDEF_ACTION),
  137.                 (title: 'Reading Error';        action: UNDEF_ACTION),
  138.                 (title: 'F.S. Error';           action: UNDEF_ACTION),
  139.                 (title: 'User Defined';         action: UNDEF_ACTION),
  140.                 (title: 'Options...';           action: UNDEF_ACTION),
  141.                 (title: '';                     action: unused_entry),
  142.                 (title: '';                     action: unused_entry) )),
  143.  
  144.  
  145.       ( border:    taildouble_border;
  146.         border_fg: white;  border_bg: black;
  147.         text_fg:   white;  text_bg:   black;
  148.         select_fg: black;  select_bg: white;
  149.         ainit:     0;      aexit:     0;
  150.  
  151.         line: ( (title: 'Header data...';       action: UNDEF_ACTION),
  152.                 (title: 'Mechanical datasheet'; action: UNDEF_ACTION),
  153.                 (title: 'Electronic datasheet'; action: UNDEF_ACTION),
  154.                 (title: 'Detail datasheet';     action: UNDEF_ACTION),
  155.                 (title: 'Display summary';      action: UNDEF_ACTION),
  156.                 (title: '';                     action: unused_entry),
  157.                 (title: '';                     action: unused_entry),
  158.                 (title: '';                     action: unused_entry),
  159.                 (title: '';                     action: unused_entry),
  160.                 (title: '';                     action: unused_entry) )),
  161.  
  162.  
  163.       ( border:    taildouble_border;
  164.         border_fg: white;  border_bg: black;
  165.         text_fg:   white;  text_bg:   black;
  166.         select_fg: black;  select_bg: white;
  167.         ainit:     0;      aexit:     0;
  168.  
  169.         line: ( (title: 'Store';                action: UNDEF_ACTION),
  170.                 (title: 'Load';                 action: UNDEF_ACTION),
  171.                 (title: 'Delete';               action: UNDEF_ACTION),
  172.                 (title: '-----------------';    action: divider_entry),
  173.                 (title: 'Working directory';    action: UNDEF_ACTION),
  174.                 (title: 'Sort order';           action: UNDEF_ACTION),
  175.                 (title: '';                     action: unused_entry),
  176.                 (title: '';                     action: unused_entry),
  177.                 (title: '';                     action: unused_entry),
  178.                 (title: '';                     action: unused_entry) )),
  179.  
  180.  
  181.       ( border:    taildouble_border;
  182.         border_fg: white;  border_bg: black;
  183.         text_fg:   white;  text_bg:   black;
  184.         select_fg: black;  select_bg: white;
  185.         ainit:     0;      aexit:     0;
  186.  
  187.         line: ( (title: 'General';              action: UNDEF_ACTION),
  188.                 (title: 'Analog inputs';        action: UNDEF_ACTION),
  189.                 (title: 'Motion control';       action: UNDEF_ACTION),
  190.                 (title: 'Density table';        action: UNDEF_ACTION),
  191.                 (title: 'Viscosity';            action: UNDEF_ACTION),
  192.                 (title: 'Special...';           action: UNDEF_ACTION),
  193.                 (title: '-----------------';    action: divider_entry),
  194.                 (title: 'stoRe settings';       action: UNDEF_ACTION),
  195.                 (title: 'Load settings';        action: UNDEF_ACTION),
  196.                 (title: 'Factory defaults';     action: UNDEF_ACTION) )),
  197.  
  198.  
  199.       ( border:    taildouble_border;
  200.         border_fg: white;  border_bg: black;
  201.         text_fg:   white;  text_bg:   black;
  202.         select_fg: black;  select_bg: white;
  203.         ainit:     0;      aexit:     0;
  204.  
  205.         line: ( (title: 'Stay';                 action: LEAVE_MENU),
  206.                 (title: 'Quit';                 action: QUIT_TOP),
  207.                 (title: '';                     action: unused_entry),
  208.                 (title: '';                     action: unused_entry),
  209.                 (title: '';                     action: unused_entry),
  210.                 (title: '';                     action: unused_entry),
  211.                 (title: '';                     action: unused_entry),
  212.                 (title: '';                     action: unused_entry),
  213.                 (title: '';                     action: unused_entry),
  214.                 (title: '';                     action: unused_entry) ))
  215.  );
  216.  
  217.  
  218. {$i \tinc\top.inc}
  219.  
  220.  
  221. function pulldown_action{pullno:   integer;   (* pulldown menu number *)
  222.                          entry:    integer;   (* entry in pulldown menu *)
  223.                          action:   integer;   (* action code *)
  224.                          var sel:  char)      (* select key *)
  225.                              : boolean};      (* true to force menu exit *)
  226.    {pulldown action routine; called when a pulldown entry is selected}
  227. begin
  228.  
  229.    case action of
  230.       UNDEF_ACTION:
  231.          begin
  232.             select_pulled(UNDEFINED_MENU,sel);
  233.             pulldown_action := false;
  234.          end;
  235.  
  236.       LEAVE_MENU:
  237.          begin
  238.             pulldown_action := true;
  239.             sel := ESC;
  240.          end;
  241.  
  242.       QUIT_TOP:
  243.          begin
  244.             pulldown_action := true;
  245.             sel := quit_sel;
  246.          end;
  247.  
  248.       else
  249.          pulldown_action := false;
  250.    end;
  251. end;
  252.  
  253.  
  254. procedure pulldown_init{pullno:    integer;
  255.                         action:    integer;
  256.                         var sel:   char};
  257.    {pulldown init routine; called when a pulldown menu is opened}
  258. var
  259.    x,y: integer;
  260. begin
  261.  
  262.    x := wherex;
  263.    y := wherey;
  264.    setcolor(green,black);
  265.    gotoxy(14,22);
  266.    displn(' '#24#25#27#26' to select,   ─┘ to activate,   F1 for Help ');
  267.  
  268.    setcolor(white,red);
  269.  
  270.    case pullno of
  271.  
  272.       UNDEFINED_MENU:  ;
  273.  
  274.       CALIB_MENU:
  275.          begin
  276.             gotoxy(20,14);   disp('                               ');
  277.             gotoxy(20,15);   disp('  Selected flow rate = ______  ');
  278.             gotoxy(20,16);   disp('       Top flow rate = ______  ');
  279.             gotoxy(20,17);   disp('    Bottom flow rate = ______  ');
  280.             gotoxy(20,18);   disp('    Flowmeter pulses = ______  ');
  281.             gotoxy(20,19);   disp('                               ');
  282.          end;
  283.  
  284.       DISPLAY_MENU:
  285.          begin
  286.             gotoxy(10,20);   disp('  Datapoint ___ out of ___  ');
  287.          end;
  288.  
  289.       GRAPH_MENU:      ;
  290.  
  291.       REPORT_MENU:     ;
  292.  
  293.       FILES_MENU:      ;
  294.  
  295.       SETUP_MENU:      ;
  296.  
  297.       QUIT_MENU:       ;
  298.    end;
  299.  
  300.    gotoxy(x,y);
  301. end;
  302.  
  303.  
  304. procedure pulldown_exit{pullno:    integer;
  305.                         action:    integer;
  306.                         var sel:   char};
  307.    {pulldown exit routine; called when a pulldown menu is closed}
  308. begin
  309. end;
  310.  
  311.  
  312. function pulldown_key   {pullno:   integer;   (* pulldown menu number *)
  313.                          entry:    integer;   (* entry in pulldown menu *)
  314.                          var sel:  char)      (* select key *)
  315.                              : boolean};      (* true to force menu exit *)
  316.    {process unknown keys}
  317.    procedure help;
  318.    var
  319.       save: window_save_rec;
  320.    begin
  321.       save_window(save);
  322.       window(1,1,80,25);
  323.       setcolor(black,yellow);
  324.       display_border(24,5,57,14,thinsolid_border);
  325.  
  326.       gotoxy(25, 6);   disp('                               ');
  327.       gotoxy(25, 7);   disp('    --- Help-on-tap ---        ');
  328.       gotoxy(25, 8);   disp('                               ');
  329.       gotoxy(25, 9);   disp('       Pulldown # ');
  330.                        write(pullno:3); disp('          ');
  331.       gotoxy(25,10);   disp('          Entry # ');
  332.                        write(entry:3); disp('          ');
  333.       gotoxy(25,11);   disp('                               ');
  334.       gotoxy(25,12);   disp('    [ Press ESC to exit ]      ');
  335.       gotoxy(25,13);   disp('                               ');
  336.  
  337.       repeat
  338.       until getkey = ESC;
  339.  
  340.       restore_window(save);
  341.    end;
  342.  
  343. begin
  344.    pulldown_key := false;
  345.  
  346.    case sel of
  347.       F1:    help;
  348.       else   disp(^G);
  349.    end;
  350. end;
  351.  
  352.  
  353. begin
  354.    init_pop_up;
  355.    setcolor(white,blue);
  356.    clrscr;
  357.  
  358.    setcolor(green,black);
  359.    gotoxy(14,22);
  360.    displn('  '#25#27#26' to select,   ─┘ to activate,   F1 for Help  ');
  361.  
  362.    setcolor(yellow,black);
  363.    gotoxy(20,24);
  364.    displn(' CALIBRON SYSTEMS - LIQUID FLOW PROVER ');
  365.  
  366.    top_menu(6,3,pull_table[0]);
  367.  
  368.    setcolor(white,blue);
  369.    clrscr;
  370. end.
  371.